home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
TPUG - Toronto PET Users Group
/
TPUG Users Group CD
/
TPUG Users Group CD.iso
/
AMIGA
/
AMICUS
/
AMICUS19.ADF
/
HouseHold
/
HouseInvPrint
< prev
next >
Wrap
Text File
|
1989-01-27
|
10KB
|
393 lines
' The Household Inventory Report Program
' --------------------------------------
' This is Program #2 of 3: :"HouseInvPrint" -reports
' Program #1 is the "HouseInv" (main) program
' Program #3 is the "HouseInvMaint" program
'
' Please do not modify the title screen in any way.
' January 1987
'
numbx=2:RecCnt=0:n=0:m=0:i=0:ErrSW=0:type=0:PageCnt=0:LineCnt=0
LoadSW=0:Limit=0:Ptr1=0:Ptr2=0:offset=0:lgth=0
A%=0:B%=0
NewSeq$="":OldSeq$="":Sep$="":x$=""
DIM bx(numbx-1,6),bxtxt$(numbx-1)
Logo80 3
BldGadgets numbx,bx(),bxtxt$()
' Help Gadgets
DATA 36,172,40,16,7,4,0,"More"
DATA 156,172,40,16,7,2,0," Ok"
HlpA%=0:HlpB%=1
COLOR Blu,Blk
LOCATE 9,39:PRINT"THE"
LOCATE 11,22:PRINT"H O U S E H O L D I N V E N T O R Y"
LOCATE 13,38:PRINT"SYSTEM"
COLOR Mag,Blk
LOCATE 16,28:PRINT"P R I N T R E P O R T S"
MENU 1,0,1,"Project:"
MENU 1,1,1,"Quit "
MENU 2,0,1,"Help:"
MENU 2,1,1,"General "
MENU 2,2,1,"Order Entry"
MENU 2,3,1,"By Room "
MENU 2,4,1,"By Item "
MENU 3,0,1,"Report:"
MENU 3,1,1,"Order Entry"
MENU 3,2,1,"By Room "
MENU 3,3,1,"By Item "
MENU 4,0,0,""
ON MENU GOSUB GetMenu
ON MOUSE GOSUB GetMouse
COLOR Yel,Blk:LOCATE 21,23
PRINT"Use Menus to select program function"
MENU ON
WaitHere:
MENU 2,0,1:MENU 3,0,1
m=0:i=0:WHILE m=0:SLEEP:WEND
MENU 2,0,0:MENU 3,0,0
ON m GOTO Quit,Help,Report
' Menu Event Routine
' ------------------
GetMenu:
m=MENU(0):i=MENU(1)
RETURN
' Mouse Event Routine
' -------------------
GetMouse:
GetGadget A%,B%,bx(),bxtxt$(),type
RETURN
' Wait for Mouse Click
' --------------------
WaitMouse:
MOUSE ON
type=0:WHILE type=0:SLEEP:WEND
MOUSE OFF
RETURN
' Open and Load Data File
' -----------------------
OpenAndLoad:
ON ERROR GOTO CountError
OPEN"HouseInv.Count" FOR INPUT AS #2
ON ERROR GOTO 0
INPUT #2,RecCnt
CLOSE #2
IF RecCnt=0 THEN OALXit
WINDOW 3,,(440,40)-(608,96),0,1
COLOR Blu,Yel:CLS
LOCATE 2,2:PRINT"Loading File..."
OPEN "R",#1,"HouseInv.Data",103
FIELD #1,1 AS FFlg$,10 AS d$(0),15 AS d$(1),8 AS d$(2),6 AS d$(3),6 AS d$(4),6 AS d$(5),15 AS d$(6),20 AS d$(7),8 AS d$(8),8 AS d$(9)
DIM Records$(RecCnt)
FOR n=1 TO RecCnt
GET #1,n
IF FFlg$="0" THEN Sep$=" " ELSE Sep$="*"
Records$(n)=Sep$
FOR m=0 TO 9
Records$(n)=Records$(n)+d$(m)+Sep$
NEXT
NEXT
CLOSE #1:LoadSW=1:ErrSW=0
WINDOW CLOSE 3
GOTO OALXit
CountError:
WINDOW 2
IF ERR=53 THEN
LoadSW=0:ErrSW=1:RESUME OALXit
ELSE
ON ERROR GOTO 0
END IF
OALXit:
RETURN
' Time to Quit and Return to Basic
' --------------------------------
Quit:
MENU OFF:MENU RESET
WINDOW CLOSE 2:SCREEN CLOSE 1
END
' Help Routines
' -------------
Help:
GOSUB DoHelp
GOTO WaitHere
' Generate Requested Report
' -------------------------
Report:
IF i=1 THEN NewSeq$="ASIS"
IF i=2 THEN NewSeq$="ROOM"
IF i=3 THEN NewSeq$="ITEM"
IF LoadSW=0 THEN GOSUB OpenAndLoad
IF ErrSW=1 OR RecCnt=0 THEN
WINDOW 3,,(440,40)-(608,92),0,1
COLOR Blu,Yel:CLS
LOCATE 2,3:PRINT"File is empty or"
LOCATE 3,3:PRINT"does not exist."
LOCATE 5,3:PRINT"Press left button"
LOCATE 6,3:PRINT"to continue."
WHILE MOUSE(0)=0:WEND
WINDOW CLOSE 3
GOTO RptXit
END IF
IF NewSeq$=OldSeq$ OR NewSeq$="ASIS" THEN DoPrint
' Looks Like We Have to Sort the File
WINDOW 3,,(440,40)-(608,92),0,1
COLOR Blu,Yel:CLS
LOCATE 2,3:PRINT"Sorting File..."
OldSeq$=NewSeq$
Limit=1:WHILE Limit<=RecCnt:Limit=2*Limit:WEND
HalfIt:
Limit=INT(Limit/2)
IF Limit=0 THEN SortDone
FOR n=1 TO RecCnt-Limit
Ptr1=n
WHILE Ptr1>0
Ptr2=Ptr1+Limit
IF NewSeq$="ROOM" THEN offset=2:lgth=10
IF NewSeq$="ITEM" THEN offset=13:lgth=15
IF MID$(Records$(Ptr1),offset,lgth)>MID$(Records$(Ptr2),offset,lgth) THEN
SWAP Records$(Ptr1),Records$(Ptr2)
Ptr1=Ptr1-Limit
ELSE
Ptr1=0
END IF
WEND
NEXT
GOTO HalfIt
SortDone:
MENU 3,1,0
WINDOW CLOSE 3
' And Now to Print the Report
DoPrint:
WINDOW 3,,(440,40)-(608,92),0,1
COLOR Blu,Yel:CLS
LOCATE 2,4:PRINT"Now Printing..."
OPEN "PRT:" FOR OUTPUT AS #3
GOSUB PageHdg
FOR n=1 TO RecCnt
IF LineCnt>55 THEN GOSUB NewPage:GOSUB PageHdg
IF NewSeq$="ITEM" THEN
x$=MID$(Records$(n),12,16)
x$=x$+MID$(Records$(n),1,11)
x$=x$+MID$(Records$(n),28,46)
ELSE
x$=MID$(Records$(n),1,73)
END IF
PRINT #3," "+x$
PRINT #3,SPACE$(30)+MID$(Records$(n),74)
LineCnt=LineCnt+2
NEXT
GOSUB NewPage:PageCnt=0:CLOSE #3
GOTO RptXit
NewPage:
PRINT #3,CHR$(12);
RETURN
PageHdg:
PRINT #3," ":PageCnt=PageCnt+1
PRINT #3,SPACE$(37);
PRINT #3,USING"-##";PageCnt;:PRINT #3,"-"
PRINT #3,SPACE$(8);
PRINT #3,CHR$(27)+"[6w";: 'Set Double width
PRINT #3,"The Household Inventory Program";
PRINT #3,CHR$(27)+"[5w": 'Set normal width
PRINT #3," "
IF NewSeq$="ITEM" THEN
PRINT #3," Item==========> Room=====>";
ELSE
PRINT #3," Room=====> Item==========>";
END IF
PRINT #3," Pur-Data OrCost CWorth RpCost Serial-Number=>"
PRINT #3,SPACE$(31)+"Comments===========> Add-Date Chg-Date"
PRINT #3," "+STRING$(72,"-")
LineCnt=9
RETURN
RptXit:
WINDOW CLOSE 3
GOTO WaitHere
' Help Routines (requested via Help Menu)
' ---------------------------------------
DoHelp:
WINDOW 4,,(408,0)-(631,186),0,1
COLOR Blu,Yel:CLS:LOCATE 2,1
ON i GOTO HlpGen,HlpASIS,HlpROOM,HlpITEM
HlpGen:
PRINT" 'HouseInvPrint' uses a"
PRINT" data file created by"
PRINT" 'HouseInv' as input and"
PRINT" produces three reports"
PRINT" from the contents of"
PRINT" that file.":PRINT" "
PRINT" A third program,"
PRINT" 'HouseInvMaint' is used"
PRINT" for functions related to"
PRINT" the maintenance of the"
PRINT" file itself, (rather than"
PRINT" the contents)."
DrawGadgets HlpB%,HlpB%,bx(),bxtxt$()
A%=HlpB%:B%=HlpB%:GOSUB WaitMouse
GOTO HlpXit
HlpASIS:
PRINT" The report is produced in"
PRINT" the same sequence as that"
PRINT" in which the items were"
PRINT" entered.":PRINT" "
PRINT" This option is only valid"
PRINT" before a report of any"
PRINT" other sequence is pro-"
PRINT" duced.":PRINT" "
GOSUB HelpCommon
DrawGadgets HlpB%,HlpB%,bx(),bxtxt$()
A%=HlpB%:B%=HlpB%:GOSUB WaitMouse
GOTO HlpXit
HlpROOM:
PRINT" The list of items is"
PRINT" sorted into room sequence"
PRINT" before the report is"
PRINT" printed.":PRINT" "
GOSUB HelpCommon:PRINT" "
PRINT" N.B. An 'Order Entry'"
PRINT" report is no longer"
PRINT" available."
DrawGadgets HlpB%,HlpB%,bx(),bxtxt$()
A%=HlpB%:B%=HlpB%:GOSUB WaitMouse
GOTO HlpXit
HlpITEM:
PRINT" The list of items is"
PRINT" sorted into item sequence"
PRINT" before the report is"
PRINT" printed.":PRINT" "
GOSUB HelpCommon:PRINT" "
PRINT" N.B. An 'Order Entry'"
PRINT" report is no longer"
PRINT" available."
DrawGadgets HlpB%,HlpB%,bx(),bxtxt$()
A%=HlpB%:B%=HlpB%:GOSUB WaitMouse
GOTO HlpXit
HelpCommon:
PRINT" Items which have been"
PRINT" deleted, but not yet re-"
PRINT" moved from the file,"
PRINT" (see 'HouseInvMaint'),"
PRINT" are listed with an '*'"
PRINT" separating the pieces of"
PRINT" information."
RETURN
HlpXit:
WINDOW CLOSE 4
RETURN
' Various Subprograms
' -------------------
SUB Logo80 (Depth%) STATIC
SHARED Blk,Blu,Grn,Cyn,Red,Mag,Yel,Wht
IF First=0 THEN
First=1
SCREEN 1,640,200,Depth%,2
WINDOW 2,,,16,1
COLOR ,0:CLS
PALETTE 0,0,0,0 :Blk=0:'Black
PALETTE 1,0,0,1 :Blu=1:'Blue
PALETTE 2,0,.75,0:Grn=2:'Green
PALETTE 3,0,1,1 :Cyn=3:'Cyan
PALETTE 4,1,0,0 :Red=4:'Red
PALETTE 5,1,0,1 :Mag=5:'Magenta
PALETTE 6,1,.8,0 :Yel=6:'Yellow
PALETTE 7,1,1,1 :Wht=7:'White
END IF
COLOR ,Blk:CLS
AREA(376,8):AREA STEP(64,0):AREA STEP(-20,16)
AREA STEP(0,24):AREA STEP(-24,0):AREA STEP(0,-24)
COLOR Blu:AREAFILL
AREA(360,8):AREA STEP(32,0):AREA STEP(0,12)
AREA STEP(-16,0):AREA STEP(0,4):AREA STEP(8,0):AREA STEP(0,8)
AREA STEP(-8,0):AREA STEP(0,4):AREA STEP(24,0):AREA STEP(0,12)
AREA STEP(-40,0):COLOR Grn:AREAFILL
AREA(328,8):AREA STEP(24,0):AREA STEP(0,28)
AREA STEP(24,0):AREA STEP(0,12):AREA STEP(-48,0)
COLOR Red:AREAFILL
AREA(272,8):AREA STEP(64,0):AREA STEP(0,12)
AREA STEP(-20,0):AREA STEP(0,28):AREA STEP(-24,0):AREA STEP(0,-28)
AREA STEP(-20,0):COLOR Cyn:AREAFILL
AREA(264,8):AREA STEP(16,0):AREA STEP(24,40)
AREA STEP(-16,0):AREA STEP(-8,-12):AREA STEP(-16,0):AREA STEP(-8,12)
AREA STEP(-16,0):COLOR Mag:AREAFILL
AREA(200,8):AREA STEP(56,0):AREA STEP(0,16)
AREA STEP(-24,0):AREA STEP(0,-4):AREA STEP(-8,0):AREA STEP(0,16)
AREA STEP(8,0):AREA STEP(0,-4):AREA STEP(24,0):AREA STEP(0,16)
AREA STEP(-56,0):COLOR Yel:AREAFILL
COLOR Blu,Blk:LOCATE 24,7
PRINT"Bryan D. Catley 2221 Glasgow Road Alexandria Virginia 22307-1819";
END SUB
SUB BldGadgets (Num,t1(),t2$()) STATIC
FOR n=0 TO Num-1
FOR m=0 TO 6
READ t1(n,m)
NEXT m
READ t2$(n)
NEXT n
END SUB
SUB DrawGadgets (Ga%,Gb%,t1(),t2$()) STATIC
FOR n=Ga% TO Gb%
x1=t1(n,0):y1=t1(n,1):x2=x1+t1(n,2):y2=y1+t1(n,3)
bg=t1(n,4):fg=t1(n,5):bo=t1(n,6)
LINE(x1,y1)-(x2,y2),bg,bf:LINE(x1,y1)-(x2,y2),fg,B
IF bo>-1 THEN
LINE(x1+2,y1+2)-(x2-2,y2-2),fg,B
LINE(x2+1,y1+1)-(x2+1,y2+1),bo
LINE(x2+1,y2+1)-(x1+1,y2+1),bo
COLOR fg,bg:row%=INT(y1/8+2):col%=INT(x1/8+2)
LOCATE row%,col%:PRINT t2$(n)
END IF
NEXT n
END SUB
SUB GetGadget (Ga%,Gb%,t1(),t2$(),type) STATIC
SHARED MouseX%,mouseY%,MouseInd
WHILE MOUSE(0)=0:WEND
r%=CSRLIN:c%=POS(0)
mx=MOUSE(1):my=MOUSE(2)
MouseX%=mx:mouseY%=my:MouseInd=0
FOR n=Ga% TO Gb%
IF mx>t1(n,0) AND mx<t1(n,0)+t1(n,2) THEN
IF my>t1(n,1) AND my<t1(n,1)+t1(n,3) THEN
bg=t1(n,4):fg=t1(n,5):bo=t1(n,6)
IF bo>-1 THEN
x1=t1(n,0)+2:y1=t1(n,1)+2
x2=x1+t1(n,2)-4:y2=y1+t1(n,3)-4
LINE(x1,y1)-(x2,y2),fg,bf
COLOR bg,fg:row%=INT(y1/8+2):col%=INT(x1/8+2)
LOCATE row%,col%:PRINT t2$(n)
ELSE
IF bo=-1 THEN
x1=t1(n,0):y1=t1(n,1):x2=x1+t1(n,2):y2=y1+t1(n,3)
LINE(x1,y1)-(x2,y2),fg,bf:LINE(x1,y1)-(x2,y2),bg,B
END IF
END IF
type=n-Ga%+1:n=Gb%:MouseInd=1
IF bo<-1 THEN
n%=type+Ga%-1:DrawGadgets n%,n%,t1(),t2$()
END IF
END IF
END IF
NEXT n
WHILE MOUSE(0)<>0:WEND
LOCATE r%,c%
END SUB